#!/usr/bin/perl

# DS Kanji Flash
# Copyright (C) 2009,2010 Bernhard Schelling
#
# This file is part of DS Kanji Flash.
#
# DS Kanji Flash is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# DS Kanji Flash is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with DS Kanji Flash.  If not, see <http://www.gnu.org/licenses/>.

use GD;
use utf8;
use IO::Uncompress::Gunzip qw(gunzip);
use strict;
use Encode;

my $outdir = "../data/";

my $jlpt_levels = "4";

my $fontfile_gothic = "./MSGOTHIC.TTF";
my $fontfile_mincho = "./MSMINCHO.TTF";

#my $fontfile_gothic = "C:\\Windows\\Fonts\\msgothic.ttc"; #xoffset -1
#my $fontfile_mincho = "C:\\Windows\\Fonts\\msmincho.ttc";

#my ($fontcw, $fontch, $fontsize, $fontxoff, $fontyoff, $fontkanjiw) = (16,15,12,0,14,17);
my ($fontcw, $fontch, $fontsize, $fontxoff, $fontyoff, $fontkanjiw) = (13,13,11,-2,12,0);
#my ($fontcw, $fontch, $fontsize, $fontxoff, $fontyoff, $fontkanjiw) = (26,25,22,0,14,17);

if ((!(-e $fontfile_gothic)) && ($fontfile_gothic eq "./MSGOTHIC.TTF"))
{
	print "Getting MSGOTHIC.TTF...\n";
	use LWP::Simple;
	my $data = get("http://download.microsoft.com/download/OfficeXPStandard/ie_ja/1/W98NT42KMe/EN-US/ie_ja.exe");
	#my $data; open(b, "unused/ie_ja.exe"); binmode(b); sysread(b, $data, (-s "unused/ie_ja.exe")); close(b);
	$data = substr($data, index($data, "\x4D\x53\x43\x46\x00\x00\x00\x00"));
	$data =~s/msgothic.ttf/MSGOTHIC.TTF/i;
	#print join(",",unpack("ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6Z*ls6", subst($data,  0x1830)));

	open(b, ">tmp.cab"); binmode(b); print b $data; close(b);
	my $cmd = '"%WINDIR%\SYSTEM32\expand.exe" tmp.cab -F:MSGOTHIC.TTF .';
	`$cmd`;
	unlink("tmp.cab");
}
unless (-e $fontfile_gothic) { die("Gothic font ".$fontfile_gothic." not found\n"); }

if ((!(-e $fontfile_mincho)) && ($fontfile_mincho eq "./MSMINCHO.TTF"))
{
	print "Getting MSMINCHO.TTF...\n";
	use LWP::Simple;
	my $data = get("http://ftp.monash.edu.au/pub/nihongo/JpnSupp.exe");
	$data = substr($data, index($data, "\x4D\x53\x43\x46\x00\x00\x00\x00"));
	$data =~s/msmincho.ttf/MSMINCHO.TTF/i;
	open(b, ">tmp.cab"); binmode(b); print b $data; close(b);
	my $cmd = '"%WINDIR%\SYSTEM32\expand.exe" tmp.cab -F:MSMINCHO.TTF .';
	`$cmd`;
	unlink("tmp.cab");

	#use IO::Uncompress::Bunzip2 qw(bunzip2);
	#my $data = get("http://osakattf.hp.infoseek.co.jp/converted/osaka.unicode.ttf.bz2");
	#my $z = new IO::Uncompress::Bunzip2 \$data;
	#binmode($z);
	#open(TTF, ">osaka.unicode.ttf"); binmode(TTF); while (<$z>) { print TTF $_; } close(TTF);
	#close($z);
}
unless (-e $fontfile_mincho) { die("Mincho font ".$fontfile_mincho." not found\n"); }

unless (-e $outdir) { mkdir($outdir); }

my ($allkanji,@kanji) = ("");

&ParseKanjiDic();
&WriteTakaDBKanaDBStrokeBin();
&WriteKanjiDicMetaData();
&WriteKanjiDicImgPool();
&WriteKanjiDicFonts();
&GenerateDictionary();
&WriteKanaImgPool();
###&WriteAlphabetFont();
###&WriteKanaFont();
exit;

sub ParseKanjiDic
{
	print "Parsing Kanji Dic...\n";
	my ($topsort, %kanjisort) = (0);
	my $z = new IO::Uncompress::Gunzip "kanjidic.gz" or die;
	<$z>;
	while (<$z>)
	{
		my $jlpt = int((/ J(\d) /)[0]);
		next if (index($jlpt_levels, (/ J(\d) /)[0]) < 0); #($jlpt <= 0); # <= 2);
		#my $sort = int((/ DT(\d+) /)[0]);
		#my $sort = int((/ L(\d+) /)[0]);
		my $sort = int((/ DF(\d+) /)[0]);
		next unless $sort;

		if ($sort > $topsort) { $topsort = $sort }

		my $l = decode("EUC-JP", $_);
		my ($k, $data) = ($l =~ /^(.)..*? ([^a-zA-Z].*)$/);
		#next unless $k eq "赤";
		#next unless index("一酸化炭素", $k) >= 0;

		$data =~ s/T.*?{/{/;
		$data =~ s/ $//;
		$kanjisort{$sort} = "$k $data";
	}

	for (my $i = 1; $i <= $topsort; $i++) { next unless $kanjisort{$i}; $allkanji .= substr($kanjisort{$i},0,1); push(@kanji, $kanjisort{$i}); }
	print "Kanjis: ".int(@kanji)."\n\n";
}

sub WriteKanjiDicMetaData
{
	print "Writing KanjiDic Metadata (metadata.txt, metadata.h)...\n";
	unless (@kanji) { print "   Requires a loaded KanjiDic!\n\n"; return; }
	open(OUT, ">".$outdir."metadata.txt");
	binmode(OUT);
	open(OUTHDR, ">".$outdir."metadata.h");
	print OUTHDR "#ifndef __METADATA_INDEX__\n#define __METADATA_INDEX__\n\n";
	print OUTHDR "#include \"metadata_txt.h\"\n\n";
	print OUTHDR "const u16 kanji_num = ".int(@kanji).";\n\nconst char* kanji[] = {\n";
	for (my $i = 0; $i < @kanji; $i++)
	{
		print OUTHDR "    (char*)metadata_txt + ".tell(OUT).",\n";
		print OUT encode("utf-8", $kanji[$i])."\n";
	}
	print OUTHDR "};\n\n#endif\n";
	close(OUTHDR);
	close(OUT);

	#open(OUT, ">".$outdir."metadata.txt.z");
	#binmode(OUT);
	##use Compress::Zlib;
	##print OUT Compress::Zlib::memGzip(encode("utf-8", $metadata));
	#print OUT $_->deflate(encode("utf-8", $metadata)).$_->flush() for scalar deflateInit();
	#close(OUT);

	print "Metadatas: ".int(@kanji)."\n\n";
}

sub WriteTakaDBKanaDBStrokeBin
{
	print "Writing stroke order for available kanjis and kanas (stroke.bin, stroke.h)...\n";
	unless (@kanji) { print "   Requires a loaded KanjiDic!\n\n"; return; }
	my ($maxpoints, @kana, %takadb, %nstrokes) = (0);
	push @kana, chr for 0x3000 .. 0x30FF;
	open(TAKADB, "<:encoding(utf-8)", "takadb.txt");
	while (<TAKADB>) { push(@{$takadb{$1}}, $2) if /(.) \d+ (.*)[\n\r]/; }
	close(TAKADB);
	open(KANADB, "<:encoding(utf-8)", "kanadb.txt");
	while (<KANADB>) { push(@{$takadb{$1}}, $2) if /(.) \d+ (.*)[\n\r]/; }
	close(KANADB);
	open(OUT, ">".$outdir."stroke.bin");
	binmode(OUT);
	open(OUTHDR, ">".$outdir."stroke.h");
	print OUTHDR "#ifndef __STROKE_INDEX__\n#define __STROKE_INDEX__\n\n";
	print OUTHDR "#include \"stroke_bin.h\"\n\n";
	print OUTHDR "const u8* kanji_stroke[] = {\n";
	for (@kanji,@kana)
	{
		my $kn = substr($_,0,1);
		if ($_ eq $kana[0]) { print OUTHDR "};\n\nconst u8* kana_stroke[] = {\n"; }
		unless ($takadb{$kn}) { print OUTHDR "    (u8*)NULL, //no defs of ".encode("utf-8", $kn)."\n"; next; } # ord($kn)."\n"; next; }
		print OUTHDR "    (u8*)stroke_bin + ".tell(OUT).", //".int(@{$takadb{$kn}})." defs of ".encode("utf-8", $kn)."\n"; #ord($kn)."\n";
		print OUT pack 'C', int(@{$takadb{$kn}});
		for my $ent (@{$takadb{$kn}})
		{
			push @{$nstrokes{int(split(/\//, $ent))}}, ord($kn);
			print OUT pack 'C', int(split(/\//, $ent));
			for my $s (split(/\//, $ent)) { my $np = int(split(/,/, $s))/2; print OUT pack 'CC*', $np, split(/,/, $s); $maxpoints = $np if $np > $maxpoints; }
		}
	}
	print OUTHDR "};\n\n";
	print OUTHDR "#define CHARS_MAX_STROKES ".@{[(sort { $b <=> $a } keys %nstrokes)]}[0]."\n\n";
	print OUTHDR "#define CHARS_MAX_POINTS ".int($maxpoints)."\n\n";
	print OUTHDR "const wchar_t chars_by_stroke_$_\[\] = { ".($nstrokes{$_}?join(", ", (sort { $a <=> $b } keys %{{map { $_ => 1 } @{$nstrokes{$_}}}})).", 0":"0")." };\n" for (@{[(sort { $a <=> $b } keys %nstrokes)]}[0] .. @{[(sort { $b <=> $a } keys %nstrokes)]}[0]);
	print OUTHDR "\nconst wchar_t* chars_by_stroke[] = {\n    NULL,\n";
	print OUTHDR "    chars_by_stroke_".$_.",\n" for (@{[(sort { $a <=> $b } keys %nstrokes)]}[0] .. @{[(sort { $b <=> $a } keys %nstrokes)]}[0]);
	print OUTHDR "};\n\n";
	print OUTHDR "#endif\n";
	close(OUTHDR);
	close(OUT);
	print "Entries Total (kanjis+kanas): ".(int(@kanji)+int(@kana))."\n\n";
}

sub WriteAlphabetFont
{
	print "Creating Alphabet Font (alphas.oft)...\n";
	my $imgalphas = new GD::Image($fontcw, $fontch*256);
	$imgalphas->colorAllocate(255,255,255);
	my $txtcolalphas = $imgalphas->colorAllocate(0,0,0);
	$imgalphas->stringFT($txtcolalphas, $fontfile_gothic, $fontsize, 0, $fontxoff, $fontyoff+(($_%0x100)*$fontch), chr($_)) for (0x00 .. 0xff);
	GDOft($imgalphas, $outdir."alphas.oft");
	print "Generated Alphabet Font\n\n";
}

sub WriteKanaFont
{
	print "Creating Kana Font (kanas.oft)...\n";
	my $imgkanas = new GD::Image($fontcw, $fontch*256);
	$imgkanas->colorAllocate(255,255,255);
	my $txtcolkanas = $imgkanas->colorAllocate(0,0,0);
	$imgkanas->stringFT($txtcolkanas, $fontfile_gothic, $fontsize-1, 0, $fontxoff, $fontyoff-1+(($_%0x100)*$fontch), chr($_)) for (0x3000 .. 0x30ff);
	GDOft($imgkanas, $outdir."kanas.oft"); #, $fontkanjiw);
	print "Generated Kana Font\n\n";
}

sub WriteKanaImgPool
{
	print "Writing Kana Images (kanapool.bin, kanapool.h)...\n";
	open(OUTIMG, ">".$outdir."kanapool.bin");
	binmode(OUTIMG);
	open(OUTHDR, ">".$outdir."kanapool.h");
	print OUTHDR "#ifndef __KANAPOOL_INDEX__\n#define __KANAPOOL_INDEX__\n\n";
	print OUTHDR "#include \"kanapool_bin.h\"\n\n";
	print OUTHDR "const u8* kanapool_png[] = {\n";
	for (0x3000 .. 0x30ff)
	{
		if ($_<0x3041||($_>0x3094&&$_<0x309B)||($_>0x309E&&$_<0x30A1)||$_>0x30FE) { print OUTHDR "    kanapool_bin + ".tell(OUTIMG).",\n"; next; }
		my $img = new GD::Image(64,64);
		$img->colorAllocate(255,255,255);
		$img->stringFT($img->colorAllocate(0,0,0), $fontfile_mincho, 49, 0, 0, 55, chr($_));
		print OUTHDR "    kanapool_bin + ".tell(OUTIMG).", //".encode("utf-8", chr($_))."\n";
		print OUTIMG $img->png;
	}
	print OUTHDR "    kanapool_bin + ".tell(OUTIMG).", // end of file\n";
	print OUTHDR "};\n\n#endif\n";
	close(OUTHDR);
	close(OUTIMG);
	print "Written Kanas: ".(256-48)."\n\n";
}

sub WriteKanjiDicImgPool
{
	print "Writing Kanji Images (kanjipool.bin, kanjipool.h)...\n";
	unless (@kanji) { print "   Requires a loaded KanjiDic!\n\n"; return; }
	open(OUTIMG, ">".$outdir."kanjipool.bin");
	binmode(OUTIMG);
	open(OUTHDR, ">".$outdir."kanjipool.h");
	print OUTHDR "#ifndef __KANJIPOOL_INDEX__\n#define __KANJIPOOL_INDEX__\n\n";
	print OUTHDR "#include \"kanjipool_bin.h\"\n\n";
	print OUTHDR "const u8* kanjipool_png[] = {\n";
	for (my $i = 0; $i < @kanji; $i++)
	{
		my $img = new GD::Image(64,64);
		$img->colorAllocate(255,255,255);
		$img->stringFT($img->colorAllocate(0,0,0), $fontfile_mincho, 49, 0, 0, 55, substr($kanji[$i],0,1));
		print OUTHDR "    kanjipool_bin + ".tell(OUTIMG).", //".encode("utf-8", substr($kanji[$i],0,1))."\n";
		print OUTIMG $img->png;
	}
	print OUTHDR "    kanjipool_bin + ".tell(OUTIMG).", // end of file\n";
	print OUTHDR "};\n\nconst int kanjipool_num = ".length($allkanji).";\n\n#endif\n";
	close(OUTHDR);
	close(OUTIMG);
	print "Kanjis In Learn Pool: ".length($allkanji)."\n\n";
}

sub WriteKanjiDicFonts
{
	print "Writing Kanji Fonts (skanjiofts.bin, skanjiofts.h)...\n";
	unless (@kanji) { print "   Requires a loaded KanjiDic!\n\n"; return; }

	open(OUT, ">".$outdir."skanji.bin"); binmode(OUT);
	open(OUTHDR, ">".$outdir."skanji.h");
	print OUTHDR "#ifndef __SKANJI_INDEX__\n#define __SKANJI_INDEX__\n\n";
	print OUTHDR "#include \"skanji_bin.h\"\n\n";
	my ($kpp, $kpw, $kph, $skwidths) = (int(40/$fontcw)*int(40/$fontch), int(40/$fontcw), int(40/$fontch));
	print OUTHDR "#define SKANJI_PERPIC $kpp\n#define SKANJI_PERWIDTH $kpw\n#define SKANJI_WIDTH $fontcw\n#define SKANJI_HEIGHT $fontch\n\nconst u8* skanji_png[] = {\n    skanji_bin + 0,\n";
	for (my $p = 0; $p < int(@kanji); $p+=$kpp)
	{
		print "   Writing Kanji Fonts for $p - ".($p+$kpp-1)."...\n";
		my $img = new GD::Image((($fontcw*$kpw+7)>>3)*8, (($fontch*$kph+7)>>3)*8);
		$img->colorAllocate(0,0,0);
		my $txtcol = $img->colorAllocate(255,255,255);
		$skwidths .= "\n    ";
		for (my $i = $p; $i < $p + $kpp && $i < int(@kanji); $i++)
		{
			my ($co, $cw, $x1, $y1) = (-1, 0, ($i%$kpw)*$fontcw, int(($i%$kpp)/$kpw)*$fontch); my ($x2, $y2) = ($x1+$fontcw-1, $y1+$fontch-1);
			$img->stringFT($txtcol, $fontfile_gothic, $fontsize, 0, $x1+$fontxoff, $y1+$fontyoff, substr($kanji[$i],0,1));
			for my $x ($x1 .. $x2) { for my $y ($y1 .. $y2) { if ($img->getPixel($x, $y)) { $co = $x-$x1; last; } } last if $co>=0; }
			if ($co>0) { for my $x ($x1+$co .. $x2+1) { for my $y ($y1 .. $y2) { $img->setPixel($x-$co, $y, ($x>$x2 ? 0 : $img->getPixel($x, $y))); } } }
			for my $x (reverse $x1 .. $x2) { for my $y ($y1 .. $y2) { if ($img->getPixel($x, $y)) { $cw = $x-$x1+1; last; } } last if $cw; }
			$skwidths.= int($cw ? $cw : int($fontcw/4)).", ";
		}
		print OUT $img->png;
		print OUTHDR "    skanji_bin + ".tell(OUT).",\n";
		#open(PNG, ">".$outdir."skanjiofts$p.png"); binmode(PNG); print PNG $img->png; close(PNG);exit;
	}
	close(OUT);
	print OUTHDR "};\n\nu8 skanji_width[] = { $skwidths\n};\n\n#endif\n";
	close(OUTHDR);

	#open(OUT, ">".$outdir."skanjiofts.bin"); close(OUT);
	#open(OUTSKHDR, ">".$outdir."skanjiofts.h");
	#print OUTSKHDR "#ifndef __SKANJIOFTS_INDEX__\n#define __SKANJIOFTS_INDEX__\n\n";
	#print OUTSKHDR "#include \"skanjiofts_bin.h\"\n\n";
	#print OUTSKHDR "#define SKANJIOFTS_NUM ".int((length($allkanji)+255-1)/255)."\n\nconst u8* skanji_oft[] = {\n    skanjiofts_bin + 0,\n";
	#for (my $x = 0; $x < int(@kanji); $x+=255)
	#{
	#	print "   Writing Kanji Fonts for $x - ".($x+255-1)."...\n";
	#	my $imgsmall = new GD::Image($fontcw, $fontch*256);
	#	$imgsmall->colorAllocate(255,255,255);
	#	my $txtcolsmall = $imgsmall->colorAllocate(0,0,0);
	#	for (my $i = $x; $i < $x + 255 && $i < int(@kanji); $i++) { $imgsmall->stringFT($txtcolsmall, $fontfile_gothic, $fontsize, 0, $fontxoff, $fontch+$fontyoff+($i%255)*$fontch, substr($kanji[$i],0,1)); }
	#	&GDOft($imgsmall, ">".$outdir."skanjiofts.bin", $fontkanjiw); #.(1+int(($i-255)/255))
	#	#&GDOft($imgsmall, "skanjiofts".(1+int($x/255)).".bin", $fontkanjiw);
	#	#GDBmpIniOft($imgsmall, "skanjiofts".(1+int($x/255)).".bin", $fontkanjiw);
	#	print OUTSKHDR "    skanjiofts_bin + ".(-s $outdir."skanjiofts.bin").",\n";
	#}
	#print OUTSKHDR "};\n\n#endif\n";
	#close(OUTSKHDR);

	#my $img = new GD::Image($fontcw*int((length($allkanji)+100-1)/100), $fontch*100);
	#$img->colorAllocate(255,255,255);
	#my $txtcol = $img->colorAllocate(0,0,0);
	#for (my $x = 0; $x < int(@kanji); $x+=100)
	#{
	#	for (my $i = $x; $i < $x + 100 && $i < int(@kanji); $i++) { $img->stringFT($txtcol, $fontfile_gothic, $fontsize, 0, ($x/100)*$fontcw+$fontxoff, $fontyoff+($i%100)*$fontch, substr($kanji[$i],0,1)); }
	#}
	#open(OUT, ">".$outdir."skanjiofts.png"); binmode(OUT); print OUT $img->png; close(OUT);

	print "Kanjis In Learn Pool: ".length($allkanji)."\n\n";
}

sub GenerateDictionary
{
	print "Generating Dictionary Entries (metadict.txt, metadict.h)...\n";
	unless (@kanji) { print "   Requires a loaded KanjiDic!\n\n"; return; }
	my ($numkanjidicts, %gotstotal, %metaindex, %dictprio, %dictunp, @dict, %useddict) = (5);
	print "   Reading applicable edict entries...\n";
	my ($ED, $lastp) = (undef, 0); open($ED, "edict.gz");
	my $z = new IO::Uncompress::Gunzip $ED or die; <$z>; while (<$z>)
	{
		my $l = decode("EUC-JP", $_);
		my $comp = ($l =~ /^(\S*)/)[0];
		next if (not $comp) or (length($comp) > 6);
		my %gots = ();
		for (split(//, $comp)) { if (index($allkanji, $_) >= 0) { $gots{$_}++; } elsif ($_ !~ /[\x{3000}-\x{30ff}]/) { %gots = (); last; } }
		next unless %gots;
		my $hasprio = ($l =~ s/\/\(P\)\//\//);
		foreach my $c (keys(%gots)) { push(@{$dictprio{$c}}, int(@dict)) if $hasprio; push(@{$dictunp{$c}}, int(@dict)) unless $hasprio; }
		push(@dict, $l);
		my $thisp = scalar(int(10000*(tell($ED) / int(-s "edict.gz")))/100);
		if ($thisp > $lastp+5) { print "      Done ".$thisp."%\n"; $lastp = $thisp; }

		#for (my $prio = 1;$prio >= 0;$prio--)
		#next unless (int($prio) == int($hasprio));
		#my $alreadyenough = 1;
		#foreach my $c (keys(%gots)) { if ($gotstotal{$c} < $numkanjidicts) { $alreadyenough = 0; $metaindex{$c} .= "(char*)metadict_txt + ".tell(OUT).", "; } $gotstotal{$c}++; }
		#next if $alreadyenough;
		#print OUT encode("utf-8", $l);
	}
	close($ED);
	print "   Sorting out $numkanjidicts dict entries out of ".int(@dict)." for all the ".length($allkanji)." kanjis...\n";
	for (split(//,$allkanji))
	{
		if (!$dictunp{$_} && !$dictprio{$_}) { $dictprio{$_} = [ ]; next; }
		while (@{$dictunp{$_}} && (!$dictprio{$_} or @{$dictprio{$_}} < $numkanjidicts)) { push(@{$dictprio{$_}}, shift @{$dictunp{$_}}); }
		my $pdict = $dictprio{$_};
		my @compall = map { ($dict[$_] =~ /^(\S*)/)[0] } @$pdict;
		my @comps; while (@comps<@$pdict&&@comps<$numkanjidicts) { push(@comps, (sort { my ($sa,$sb); for (@comps) { $sa += comparestrings($_,$a); $sb += comparestrings($_,$b); } $sa <=> $sb; } @compall)[0]); } 
		@$pdict = map { my $i = 0; $i++ while ($compall[$i] ne $_); @$pdict[$i]; } @comps;
		for (@$pdict) { $useddict{$_}++; }
		print "      Done ".index($allkanji, $_)." Kanjis\n" if (index($allkanji, $_) % int((length($allkanji)+9.9)/10))==0;
	}
	print "   Writing data into metadict.txt database and metadict.h header...\n";
	open(OUT, ">".$outdir."metadict.txt"); binmode(OUT);
	for (sort { $a <=> $b } keys %useddict) { $useddict{$_} = "(char*)metadict_txt + ".tell(OUT); print OUT encode("utf-8", $dict[$_]); }
	close(OUT);

	open(OUTHDR, ">".$outdir."metadict.h");
	print OUTHDR "#ifndef __METADICT_INDEX__\n#define __METADICT_INDEX__\n\n";
	print OUTHDR "#include \"metadict_txt.h\"\n\n";
	print OUTHDR "#define METANUMKANJIDICTS $numkanjidicts\n\n";
	print OUTHDR "const char* metadict[][METANUMKANJIDICTS] = {\n";
	for (split(//,$allkanji)) { print OUTHDR "    { ".join(", ", map { $useddict{$_} } @{$dictprio{$_}}).(", NULL"x($numkanjidicts-int(@{$dictprio{$_}})))." },\n"; }
	#for (my $i = 0; $i < @kanji; $i++) { print OUTHDR "    { ".$metaindex{substr($kanji[$i],0,1)}.(", 0"x($numkanjidicts-$gotstotal{substr($kanji[$i],0,1)}))."},\n"; }
	print OUTHDR "};\n\n#endif\n";
	close(OUTHDR);

	#open(OUT, ">".$outdir."metadict.txt.z");
	#binmode(OUT);
	##use Compress::Zlib;
	##print OUT Compress::Zlib::memGzip(encode("utf-8", $metadict));
	#print OUT $_->deflate(encode("utf-8", $metadict)).$_->flush() for scalar deflateInit();
	#close(OUT);

	print "Generated Dictionary Entries\n\n";
}

sub comparestrings
{
	my ($a, $b) = @_;
	if ($a eq $b) { return 0; }
	my ($score, $p) = (-10000);
	$score -= int(sqrt(abs(length($a)-length($b)))*10);
	#print "COMP '$a' <-> '$b' = $score\n";
	$score += 70 if (index($a, $b) >= 0);
	$score += 70 if (index($b, $a) >= 0);
	for (split(//,$a)) { my $i = index($b,$_); if ($i>=0) { if ($p) { my $pi = index($b,$p); if ($pi>=0&&$i>$pi) { $score += 20; } } $score += 10+($i==index($a,$_)?20:0); } $p = $_; }
	for (split(//,$b)) { my $i = index($a,$_); if ($i>=0) { if ($p) { my $pi = index($a,$p); if ($pi>=0&&$i>$pi) { $score += 20; } } $score += 10+($i==index($b,$_)?20:0); } $p = $_; }
	return $score;
}

sub GDOft
{
	my ($img, $filename, $forcecw) = @_;
	open(OFT, ">".$filename); binmode(OFT);
	my($w, $h) = $img->getBounds(); my $linew = 1+(($w-1)>>3); #($w+(8-($w%8)))>>3;
	print OFT pack 'a12CCxxlllCSa33', "OSLFont v01", 1, 1, $w, ($h/256), $linew, 0, 0, ''; # pixelFormat, variableWidth, width, height, bytes per line, added space, palcount, reserve29byte
	#for (my $i=0;$i<256;$i++) { print OFT pack 'C', 13; } #variable widths
	for (my $i=0;$i<256;$i++)
	{
		if ($forcecw) { print OFT pack 'C', $forcecw; next }
		my ($co, $cw, $ch, $cy) = (-1, 0, ($h/256), ($i*($h/256)));
		for my $x (0 .. $w-1) { for my $y (0 .. $ch-1) { if ($img->getPixel($x, $cy+$y)) { $co = $x; last; } } last if $co>=0; }
		#if ($co>0) { for my $x ($co .. $w) { for my $y (0 .. $ch-1) { $img->setPixel($x-$co, $cy+$y, ($x>=$w ? 0 : $img->getPixel($x, $cy+$y))); } } }
		for my $x (reverse 0 .. $w-1) { for my $y (0 .. $ch-1) { if ($img->getPixel($x, $cy+$y)) { $cw = $x; last; } } last if $cw; }
		print OFT pack 'C', ($cw ? $cw+4 : int($w/2));
	}
	for my $y (0 .. $h-1) { my @l; $l[($w-1)>>3] = 0; for my $x (0 .. $w-1) { $l[$x>>3] |= 1<<(($x&7)) if $img->getPixel($x, $y); } print OFT pack("C*", @l); }
	close(OFT);
	open(OUT, ">$filename".rand().".png"); binmode(OUT); print OUT $img->png; close(OUT);
}

sub GDBmpIniOft
{
	my ($img, $filename, $forcecw) = @_;
	my($w, $h) = $img->getBounds(); my $wpad = 4-(($w*3)%4);
	open(INI, ">".$filename.".ini");
	print INI "width = ".($w)."\nheight = ".($h/256)."\nvariable = 1\nbitplanes = 1\npal[count] = 2\npal[0] = #ffffff\npal[1] = #000000\n";
	##for (my $i=0;$i<256;$i++) { printf INI "%03d (%c) = %d\n", $i, ($i>32&&$i<127?$i:32), $w-1; }
	for (my $i=0;$i<256;$i++)
	{
		if ($forcecw) { printf INI "%03d (%c) = %d\n", $i, ($i>32&&$i<127?$i:32), $forcecw; next }
		my ($co, $cw, $ch, $cy) = (-1, 0, ($h/256), ($i*($h/256)));
		for my $x (0 .. $w-1) { for my $y (0 .. $ch-1) { if ($img->getPixel($x, $cy+$y)) { $co = $x; last; } } last if $co>=0; }
		if ($co>0) { for my $x ($co .. $w-1) { for my $y (0 .. $ch-1) { $img->setPixel($x-$co, $cy+$y, $img->getPixel($x, $cy+$y)); } } }
		for my $x (reverse 0 .. $w-1) { for my $y (0 .. $ch-1) { if ($img->getPixel($x, $cy+$y)) { $cw = $x; last; } } last if $cw; }
		printf INI "%03d (%c) = %d\n", $i, ($i>32&&$i<127?$i:32), ($cw ? $cw+4 : int($w/2));
	}
	close(INI);
	open BMP, '>:raw', $filename.".bmp"; binmode BMP;
	printf BMP '%s', pack 'A2ISSI', 'BM', $w * $h +54, 0, 0, 54;
	printf BMP '%s', pack 'IiiSSIIiiII', 40, $w, $h, 1, 24, 0, (($w*3)+$wpad) * $h, 11811, 11811, 0, 0;
	for my $y (reverse 0 .. $h-1) { for my $x ( 0 .. $w-1 ) { print BMP pack('CCC', ($img->getPixel($x, $y) ? (0,0,0) : (255,255,255))); } print BMP "\0"x$wpad; } # pack 'CCC', $img->rgb($img->getPixel($x, $y)); } }
	close BMP;
}

sub EncodeJPK
{
	my $out;
	for (map { ord } split //, $_[0])
	{
		print "ENC: $_\n";
		if ($_ < 128) { $out .= chr; }
		elsif ($_ >= 0x3000 && $_ <= 0x30FF) { $out .= pack('CC', 128, $_-0x3000); }
		else { my $i = index($allkanji, chr($_)); die "Can't encode character $_ ('".chr($_)."')\n" if $i < 0; $out .= pack('CC', 129+($i>>8), ($i&255)); }
	}
	return $out;
}